Mammals and Water Availability: Map Study Area

The aim of this study is to assess the effect of water scarcity on the distribution of an African herbivore guild along the Ruaha River, TZ

Stephanie Kramer-Schadt https://ecodynizw.github.io (Leibniz Institute for Zoo and Wildlife Research)https://izw-berlin.de/en/ , Cédric Scherer https://cedricscherer.com (Leibniz Institute for Zoo and Wildlife Research)https://izw-berlin.de/en/
November 13, 2023

Setup

invisible(sapply(
  list("d6", "sf", "dplyr", "readr", "tidyr", "terra" , "ggplot2", "stars", "ggspatial", 
       "rcartocolor", "colorspace", "systemfonts", "patchwork", "here", "ggdensity"), 
  library, character.only = TRUE, logical.return = TRUE
))

# ggplot theme
theme_set(theme_d6(legend = c(.48,.95)))
theme_update(
  axis.text = element_text(),
  legend.text = element_text(size = rel(.95)),
  legend.key.height = unit(.2, "lines"),
  legend.key.width = unit(1.5, "lines"),
  legend.position = c(.48, .95),
  legend.direction = "horizontal"
)

Figure 1: Map Study Site

Data

## park boundary
park_bounds_ruaha_utm <- 
  st_read(here("data", "park_bounds_ruaha_32636_edited.gpkg"))

## normalized difference vegetation index
ndvi <- rast(here("data", "ndvi_201307_crop_32636.tif"))
# ndvi <- rast(here("data", "ndvi_201310_crop_32636.tif"))

## transects
transects <- 
  read.table(here("data", "stommel_mastertable_20230127.txt"), 
                  header = TRUE, dec = ".", na.strings = "NA", stringsAsFactors = TRUE) |> 
  st_as_sf(coords = c("lon", "lat"), crs = 4326) |> 
  st_transform(st_crs(ndvi))

transects_buffer <- transects |> st_buffer(2000)

transect_ids <- 
  tibble::tribble(
    ~id,  ~lon,   ~lat,
    "5",  35.22,  -7.4,
    "10", 35.08,  -7.55,
    "9",  35.022, -7.62,
    "4",  34.93,  -7.63,  
    "8",  34.89,  -7.76,
    "3",  34.77,  -7.73,  
    "7",  34.77,  -7.835,
    "2",  34.65,  -7.753, 
    "6",  34.67,  -7.88,
    "1",  34.54,  -7.85
  ) |> 
  st_as_sf(coords = c("lon", "lat"), crs = 4326)

ndvi_c <- crop(ndvi, transects_buffer)
values(ndvi_c) <- values(ndvi_c) / 10000


## rivers
rivers_ruaha_utm <- st_read(here("data", "rivers_osm_ruaha_32636.gpkg"))

rivers_ruaha_utm_c <- st_crop(rivers_ruaha_utm, transects_buffer)

rivers_ruaha_utm_sub <- 
  rivers_ruaha_utm_c |> 
  ## remove rivers that are not considered
  filter(
    !(substr(osm_id, 1, 4) %in% c("4944", "3629", "9659", "3346")),
    osm_id != "378460637"
  ) |> 
  ## add type information to color based on main vs sand rivers
  mutate(
    type = if_else(name %in% c("Great Ruaha", "Jongomero"), "main", "sand"),
    type = factor(type, levels = c("pool", "sand", "main", "transect"))
  )


## pools
pools <- 
  vroom::vroom(here("data", "ruaha_spring_pools.csv")) |> 
  add_row(WAT_ID = 0000, ID_POOL = "Legend", LON = 35.03, LAT = -7.378) |> 
  st_as_sf(coords = c("LON", "LAT"), crs = 4326) |> 
  st_transform(st_crs(park_bounds_ruaha_utm))


## bounding box
bbox <- st_bbox(ndvi_c)

Map

map <- 

  ggplot() +
   
  ## ndvi
  geom_stars(data = st_as_stars(ndvi_c), alpha = 1) +
  scale_fill_continuous_sequential(
    trans = "exp", palette = "Terrain 2", begin = .1, guide = "none",
    breaks = c(seq(-.4, .8, by = .2)), limits = c(-.4, NA)
  ) +

  ggnewscale::new_scale_fill() +
  
  ## river outlines
  geom_sf(data = st_buffer(rivers_ruaha_utm_sub, 500), aes(fill = type), lwd = 0) +
  scale_fill_manual(
    values = c("transparent", "#ebcc3b", "#a1c2e2", "black"), guide = guide_legend(reverse = TRUE), 
    labels = c("Pools", "Sand river  ", "Main river   ", "Transects   "), name = NULL, drop = FALSE
  ) +
  
  ## park boundaries
  geom_sf(
    data = park_bounds_ruaha_utm, color = "grey35", fill = NA, 
    lwd = .6, linetype = "32", lineend = "round"
  ) +

  ## rivers
  geom_sf(data = rivers_ruaha_utm_sub, aes(color = type), lwd = .8) +
  scale_color_manual(
    values = c("transparent", "#977d16", "#1568b8", "white"), guide = guide_legend(reverse = TRUE), 
    labels = c("Pools", "Sand river  ", "Main river   ", "Transects   "), name = NULL, drop = FALSE
  ) +
    
  ## transects
  geom_sf(data = transects, color = "black", size = 1.5) +
  geom_sf(data = transects, color = "white", size = .05) +
  geom_sf_text(
    data = transect_ids, aes(label = id), 
    size = 5, family = "PT Serif", fontface = "bold", color = "gray10"
  ) +
  
  ## pools
  geom_sf(data = pools, size = 10, shape = "★", color = "white") +
  geom_sf(data = pools, size = 6, shape = "★", color = "firebrick") +

  ## north arrow + scaale bar
  ggspatial::annotation_scale(
    location = "br", text_family = "PT Sans", text_cex = .9, width_hint = .4,
    pad_x = unit(4.5, "lines"), pad_y = unit(.35, "cm"), text_pad = unit(.35, "cm")
  ) +
  ggspatial::annotation_north_arrow(location = "br") +
  
  ## bounding box
  coord_sf(expand = FALSE, xlim = bbox[c(1,3)], ylim = bbox[c(2,4)]) +
  
  ## axis titles
  labs(x = "Longitude", y = "Latitude")


park <-
  ggplot() +
   
  ## park boundaries
  geom_sf(
    data = park_bounds_ruaha_utm, color = "grey35", fill = "white",
    lwd = .5, linetype = "32", lineend = "round"
  ) +

  ## rivers
  geom_sf(data = rivers_ruaha_utm_sub, aes(color = type), lwd = .5) +
  scale_color_manual(
    values = c("#977d16", "#1568b8"), guide = "none"
  ) +
  
  ## bounding box
  geom_sf(data = st_as_sfc(bbox), color = "black", fill = NA, linewidth = 1.2) +
  
  ## projection
  coord_sf(crs = st_crs(park_bounds_ruaha_utm)) +
  
  ## theming
  theme_void() +
  theme(panel.background = element_rect(fill = NA, color = NA))


globe <- 
  d6berlin::globe(
    col_earth = "grey80", #"#B7D19D",
    col_water = "white", #"#A9C9EB",
    bg = TRUE,
    center = c(34.93544, -0.68140)
  )
  

map_globe <- map + 
  inset_element(park, left = 0, right = .21, bottom = .5, top = .75) +
  inset_element(globe, left = 0, right = .21, bottom = .76, top = .99)

map_globe
ggsave(here("plots", "Fig1_study_area.png"), 
       width = 10, height = 7.67, dpi = 600, bg = "white") 

Session Info
[1] "2023-11-13 15:09:48 CET"
git2r::repository()
Local:    master C:/Users/scherer/PopDynCloud/Projects/mammals_africa_transects_schmied_c
Remote:   master @ origin (https://github.com/EcoDynIZW/mammals_africa_transects_schmied_c.git)
Head:     [5a24614] 2023-10-23: clean script 1
R version 4.3.0 (2023-04-21 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19041)

Matrix products: default


locale:
[1] LC_COLLATE=English_United States.utf8 
[2] LC_CTYPE=English_United States.utf8   
[3] LC_MONETARY=English_United States.utf8
[4] LC_NUMERIC=C                          
[5] LC_TIME=C                             

time zone: Europe/Berlin
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods  
[7] base     

other attached packages:
 [1] ggdensity_1.0.0   here_1.0.1        patchwork_1.1.2  
 [4] systemfonts_1.0.4 colorspace_2.1-0  rcartocolor_2.1.1
 [7] ggspatial_1.1.8   stars_0.6-1       abind_1.4-5      
[10] ggplot2_3.4.2     terra_1.7-29      tidyr_1.3.0      
[13] readr_2.1.4       dplyr_1.1.2       sf_1.0-13        
[16] d6_0.1.0.4       

loaded via a namespace (and not attached):
 [1] DBI_1.1.3          s2_1.1.4           remotes_2.4.2     
 [4] rlang_1.1.1        magrittr_2.0.3     git2r_0.32.0      
 [7] e1071_1.7-13       compiler_4.3.0     callr_3.7.3       
[10] vctrs_0.6.2        stringr_1.5.0      profvis_0.3.8     
[13] wk_0.7.3           pkgconfig_2.0.3    crayon_1.5.2      
[16] fastmap_1.1.1      ellipsis_0.3.2     lwgeom_0.2-13     
[19] utf8_1.2.3         promises_1.2.0.1   rmarkdown_2.22    
[22] sessioninfo_1.2.2  tzdb_0.4.0         ps_1.7.5          
[25] ragg_1.2.5         purrr_1.0.1        bit_4.0.5         
[28] xfun_0.39          cachem_1.0.8       jsonlite_1.8.5    
[31] highr_0.10         later_1.3.1        parallel_4.3.0    
[34] prettyunits_1.1.1  R6_2.5.1           bslib_0.5.0       
[37] stringi_1.7.12     pkgload_1.3.2      jquerylib_0.1.4   
[40] Rcpp_1.0.10        knitr_1.43         usethis_2.2.0     
[43] httpuv_1.6.11      tidyselect_1.2.0   rstudioapi_0.14   
[46] yaml_2.3.7         codetools_0.2-19   miniUI_0.1.1.1    
[49] processx_3.8.1     pkgbuild_1.4.1     tibble_3.2.1      
[52] shiny_1.7.4        withr_2.5.0        evaluate_0.21     
[55] desc_1.4.2         units_0.8-2        proxy_0.4-27      
[58] urlchecker_1.0.1   pillar_1.9.0       KernSmooth_2.23-20
[61] generics_0.1.3     vroom_1.6.3        rprojroot_2.0.3   
[64] hms_1.1.3          munsell_0.5.0      scales_1.2.1      
[67] xtable_1.8-4       class_7.3-21       glue_1.6.2        
[70] tools_4.3.0        ggnewscale_0.4.9   d6berlin_1.0.0    
[73] distill_1.6        fs_1.6.2           grid_4.3.0        
[76] devtools_2.4.5     cli_3.6.1          textshaping_0.3.6 
[79] fansi_1.0.4        downlit_0.4.2      gtable_0.3.3      
[82] sass_0.4.6         digest_0.6.31      classInt_0.4-9    
[85] htmlwidgets_1.6.2  farver_2.1.1       memoise_2.0.1     
[88] htmltools_0.5.5    lifecycle_1.0.3    mime_0.12         
[91] bit64_4.0.5        MASS_7.3-58.4